home *** CD-ROM | disk | FTP | other *** search
/ Micromanía 93 / CDMM_93_2.ISO / Project Nomads / nomads_demo_eng.exe / MSGCAT.TCL < prev    next >
Encoding:
Text File  |  2000-12-15  |  8.0 KB  |  303 lines
  1. # msgcat.tcl --
  2. #
  3. #    This file defines various procedures which implement a
  4. #    message catalog facility for Tcl programs.  It should be
  5. #    loaded with the command "package require msgcat".
  6. #
  7. # Copyright (c) 1998-2000 by Ajuba Solutions.
  8. # Copyright (c) 1998 by Mark Harrison.
  9. #
  10. # See the file "license.terms" for information on usage and redistribution
  11. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  12. # 
  13. # RCS: @(#) $Id: msgcat.tcl,v 1.1 2000/12/15 20:10:58 floh Exp $
  14.  
  15. package provide msgcat 1.2
  16.  
  17. namespace eval msgcat {
  18.     namespace export mc mcset mcmset mclocale mcpreferences mcunknown mcmax
  19.  
  20.     # Records the current locale as passed to mclocale
  21.     variable locale ""
  22.  
  23.     # Records the list of locales to search
  24.     variable loclist {}
  25.  
  26.     # Records the mapping between source strings and translated strings.  The
  27.     # array key is of the form "<locale>,<namespace>,<src>" and the value is
  28.     # the translated string.
  29.     array set msgs {}
  30. }
  31.  
  32. # msgcat::mc --
  33. #
  34. #    Find the translation for the given string based on the current
  35. #    locale setting. Check the local namespace first, then look in each
  36. #    parent namespace until the source is found.  If additional args are
  37. #    specified, use the format command to work them into the traslated
  38. #    string.
  39. #
  40. # Arguments:
  41. #    src    The string to translate.
  42. #    args    Args to pass to the format command
  43. #
  44. # Results:
  45. #    Returns the translatd string.  Propagates errors thrown by the 
  46. #    format command.
  47.  
  48. proc msgcat::mc {src args} {
  49.     # Check for the src in each namespace starting from the local and
  50.     # ending in the global.
  51.  
  52.     set ns [uplevel {namespace current}]
  53.     
  54.     while {$ns != ""} {
  55.     foreach loc $::msgcat::loclist {
  56.         if {[info exists ::msgcat::msgs($loc,$ns,$src)]} {
  57.         if {[llength $args] == 0} {
  58.             return $::msgcat::msgs($loc,$ns,$src)
  59.         } else {
  60.             return [eval \
  61.                 [list format $::msgcat::msgs($loc,$ns,$src)] \
  62.                 $args]
  63.         }
  64.         }
  65.     }
  66.     set ns [namespace parent $ns]
  67.     }
  68.     # we have not found the translation
  69.     return [uplevel 1 [list [namespace origin mcunknown] \
  70.         $::msgcat::locale $src] $args]
  71. }
  72.  
  73. # msgcat::mclocale --
  74. #
  75. #    Query or set the current locale.
  76. #
  77. # Arguments:
  78. #    newLocale    (Optional) The new locale string. Locale strings
  79. #            should be composed of one or more sublocale parts
  80. #            separated by underscores (e.g. en_US).
  81. #
  82. # Results:
  83. #    Returns the current locale.
  84.  
  85. proc msgcat::mclocale {args} {
  86.     set len [llength $args]
  87.  
  88.     if {$len > 1} {
  89.     error {wrong # args: should be "mclocale ?newLocale?"}
  90.     }
  91.  
  92.     set args [string tolower $args]
  93.     if {$len == 1} {
  94.     set ::msgcat::locale $args
  95.     set ::msgcat::loclist {}
  96.     set word ""
  97.     foreach part [split $args _] {
  98.         set word [string trimleft "${word}_${part}" _]
  99.         set ::msgcat::loclist [linsert $::msgcat::loclist 0 $word]
  100.     }
  101.     }
  102.     return $::msgcat::locale
  103. }
  104.  
  105. # msgcat::mcpreferences --
  106. #
  107. #    Fetch the list of locales used to look up strings, ordered from
  108. #    most preferred to least preferred.
  109. #
  110. # Arguments:
  111. #    None.
  112. #
  113. # Results:
  114. #    Returns an ordered list of the locales preferred by the user.
  115.  
  116. proc msgcat::mcpreferences {} {
  117.     return $::msgcat::loclist
  118. }
  119.  
  120. # msgcat::mcload --
  121. #
  122. #    Attempt to load message catalogs for each locale in the
  123. #    preference list from the specified directory.
  124. #
  125. # Arguments:
  126. #    langdir        The directory to search.
  127. #
  128. # Results:
  129. #    Returns the number of message catalogs that were loaded.
  130.  
  131. proc msgcat::mcload {langdir} {
  132.     set x 0
  133.     foreach p [::msgcat::mcpreferences] {
  134.     set langfile [file join $langdir $p.msg]
  135.     if {[file exists $langfile]} {
  136.         incr x
  137.         set fid [open $langfile "r"]
  138.         fconfigure $fid -encoding utf-8
  139.             uplevel [list eval [read $fid]]
  140.         close $fid
  141.     }
  142.     }
  143.     return $x
  144. }
  145.  
  146. # msgcat::mcset --
  147. #
  148. #    Set the translation for a given string in a specified locale.
  149. #
  150. # Arguments:
  151. #    locale        The locale to use.
  152. #    src        The source string.
  153. #    dest        (Optional) The translated string.  If omitted,
  154. #            the source string is used.
  155. #
  156. # Results:
  157. #    Returns the new locale.
  158.  
  159. proc msgcat::mcset {locale src {dest ""}} {
  160.     if {[string equal $dest ""]} {
  161.     set dest $src
  162.     }
  163.  
  164.     set ns [uplevel {namespace current}]
  165.  
  166.     set ::msgcat::msgs([string tolower $locale],$ns,$src) $dest
  167.     return $dest
  168. }
  169.  
  170. # msgcat::mcmset --
  171. #
  172. #    Set the translation for multiple strings in a specified locale.
  173. #
  174. # Arguments:
  175. #    locale        The locale to use.
  176. #    pairs        One or more src/dest pairs (must be even length)
  177. #
  178. # Results:
  179. #    Returns the number of pairs processed
  180.  
  181. proc msgcat::mcmset {locale pairs } {
  182.  
  183.     set length [llength $pairs]
  184.     if {$length % 2} {
  185.     error {bad translation list: should be "mcmset locale {src dest ...}"}
  186.     }
  187.     
  188.     set locale [string tolower $locale]
  189.     set ns [uplevel {namespace current}]
  190.     
  191.     foreach {src dest} $pairs {
  192.         set ::msgcat::msgs($locale,$ns,$src) $dest
  193.     }
  194.     
  195.     return $length
  196. }
  197.  
  198. # msgcat::mcunknown --
  199. #
  200. #    This routine is called by msgcat::mc if a translation cannot
  201. #    be found for a string.  This routine is intended to be replaced
  202. #    by an application specific routine for error reporting
  203. #    purposes.  The default behavior is to return the source string.  
  204. #    If additional args are specified, the format command will be used
  205. #    to work them into the traslated string.
  206. #
  207. # Arguments:
  208. #    locale        The current locale.
  209. #    src        The string to be translated.
  210. #    args        Args to pass to the format command
  211. #
  212. # Results:
  213. #    Returns the translated value.
  214.  
  215. proc msgcat::mcunknown {locale src args} {
  216.     if {[llength $args]} {
  217.     return [eval [list format $src] $args]
  218.     } else {
  219.     return $src
  220.     }
  221. }
  222.  
  223. # msgcat::mcmax --
  224. #
  225. #    Calculates the maximun length of the translated strings of the given 
  226. #    list.
  227. #
  228. # Arguments:
  229. #    args    strings to translate.
  230. #
  231. # Results:
  232. #    Returns the length of the longest translated string.
  233.  
  234. proc msgcat::mcmax {args} {
  235.     set max 0
  236.     foreach string $args {
  237.         set len [string length [msgcat::mc $string]]
  238.         if {$len>$max} {
  239.             set max $len
  240.         }
  241.     }
  242.     return $max
  243. }
  244.  
  245. # Initialize the default locale
  246.  
  247. namespace eval msgcat {
  248.     # set default locale, try to get from environment
  249.     if {[info exists ::env(LANG)]} {
  250.         mclocale $::env(LANG)
  251.     } else {
  252.         if { $tcl_platform(platform) == "windows" } {
  253.             # try to set locale depending on registry settings
  254.             #
  255.             set key {HKEY_CURRENT_USER\Control Panel\International}
  256.             if {[catch {package require registry}] || \
  257.             [catch {registry get $key "locale"} locale]} {
  258.                 mclocale "C"
  259.             } else {
  260.         
  261.                 #
  262.                 # Clean up registry value for translating LCID value
  263.                 # by using only the last 2 digits, since first
  264.                 # 2 digits appear to be the country...  For example
  265.                 #     0409 - English - United States
  266.                 #     0809 - English - United Kingdom
  267.                 #
  268.                 set locale [string trimleft $locale "0"]
  269.                 set locale [string range $locale end-1 end]
  270.                 set locale [string tolower $locale]
  271.                 switch -- $locale {
  272.             01      { mclocale "ar" }
  273.             02      { mclocale "bg" }
  274.             03      { mclocale "ca" }
  275.             04      { mclocale "zh" }
  276.             05      { mclocale "cs" }
  277.             06      { mclocale "da" }
  278.             07      { mclocale "de" }
  279.             08      { mclocale "el" }
  280.             09      { mclocale "en" }
  281.             0a      { mclocale "es" }
  282.             0b      { mclocale "fi" }
  283.             0c      { mclocale "fr" }
  284.             0d      { mclocale "he" }
  285.             0e      { mclocale "hu" }
  286.             0f      { mclocale "is" }
  287.             10      { mclocale "it" }
  288.             11      { mclocale "ja" }
  289.             12      { mclocale "ko" }
  290.             13      { mclocale "da" }
  291.             14      { mclocale "no" }
  292.             15      { mclocale "pl" }
  293.             16      { mclocale "pt" }
  294.             
  295.             default  { mclocale "C" }
  296.         }
  297.             }
  298.         } else {
  299.             mclocale "C"
  300.         }
  301.     }
  302. }
  303.